home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / lib / qp_interface.pl < prev    next >
Encoding:
Text File  |  1992-05-26  |  6.7 KB  |  262 lines
  1. /*  $Id: qp_interface.pl,v 1.1.1.1 1992/05/26 11:51:37 jan Exp $
  2.  
  3.     Copyright (c) 1991 Jan Wielemaker. All rights reserved.
  4.     jan@swi.psy.uva.nl
  5.  
  6.     Purpose: Quintus editor interface support
  7. */
  8.  
  9. :- module(qp_interface,
  10.       [ '$editor_load_code'/2
  11.       , find_predicate1/2
  12.       , qp_consult/1
  13.       , qp_dabbrev_atom/1
  14.       , qp_complete_atom/1
  15.       , qp_previous_command/0
  16.       , qp_next_command/0
  17.       ]).
  18.  
  19.  
  20.         /********************************
  21.         *              UTIL        *
  22.         ********************************/
  23.  
  24. running_under_qp_interface :-
  25.     qp_tmp_file(_).
  26.  
  27. qp_tmp_file(File) :-
  28.     '$argv'(Argv),
  29.     tmp_file(Argv, File).
  30.  
  31. tmp_file(['+C', Raw|_], File) :- !,
  32.     concat('Emacs:', File, Raw).
  33. tmp_file([_|T], File) :-
  34.     tmp_file(T, File).
  35.  
  36.  
  37.         /********************************
  38.         *            SETUP        *
  39.         ********************************/
  40.  
  41. :- (   running_under_qp_interface
  42.    ->  '$set_prompt'('a%m%l%! ?- ')
  43.    ;   true
  44.    ).
  45.  
  46.  
  47.         /********************************
  48.         *           CONSULT        *
  49.         ********************************/
  50.  
  51. %    '$editor_load_code'(+Kind, +File)
  52. %    Load code from EMACS.  `Kind' is {procedure,region,buffer}.  
  53. %    `File' is the name of the file from which the code comes.  It
  54. %    is an absolute filename.
  55. %    
  56. %    To be implemented.  There is a start for portions of a file
  57. %    (region, procedure), but this is hard:  What is the starting
  58. %    line of the region (for error-messages).  There is also a
  59. %    problem with path-names: `File' is emacs notion of the absolute
  60. %    filename.  SWI-Prologs notion may be different due to symbolic
  61. %    links.  Finally: the region might be the entire file, in which
  62. %    case we need to know about the module info ...
  63.  
  64. '$editor_load_code'(_buffer, File) :- !,
  65.     format('Kind = ~w; File = ~w~n', [buffer, File]),
  66.     qp_tmp_file(TmpFile),
  67.     concat('ls -l ', TmpFile, Cmd),
  68.     shell(Cmd).
  69. '$editor_load_code'(_Kind, File) :-
  70.     trace,
  71.     qp_tmp_file(TmpFile),
  72.     '$load_context_module'(File, Module),
  73.     '$set_source_module'(OldModule, Module),
  74.     '$start_consult'(File),
  75.     '$style_check'(OldStyle, OldStyle),
  76.     seeing(Old), see(TmpFile),
  77.     repeat,
  78.         '$read_clause'(Clause),
  79.         '$consult_clause'(Clause, File), !,
  80.     seen, see(Old),
  81.     '$style_check'(_, OldStyle),
  82.     '$set_source_module'(_, OldModule).
  83.  
  84.  
  85.         /********************************
  86.         *    TELL EMACS ABOUT ERRORS    *
  87.         ********************************/
  88.  
  89. %    Redefine [] to clear the compilation-buffer first
  90.  
  91. :- (   running_under_qp_interface
  92.    ->  user:abolish('.', 2),
  93.        user:abolish(make, 0),
  94.        user:(module_transparent '.'/2),
  95.        user:assert(([H|T] :- qp_consult([H|T]))),
  96.        user:assert((make :- qp_interface:make)),
  97.        user:assert(exception(A,B,C) :- qp_interface:exception(A,B,C))
  98.    ;   true
  99.    ).
  100.  
  101.  
  102. :- dynamic
  103.     compilation_base_dir/1.
  104.  
  105. :- module_transparent
  106.     qp_consult/1.
  107.  
  108. qp_consult(Files) :-
  109.     qp_start_compilation,
  110.     consult(Files),
  111.     qp_finish_compilation.
  112.  
  113.  
  114. make :-
  115.     qp_start_compilation,
  116.     system:make,
  117.     qp_finish_compilation.
  118.     
  119.  
  120. exception(syntax_error, syntax_error(Path, Line, Warning), _) :-
  121.     qp_warning_file(Path, File),
  122.     sformat(Msg, 'Error: ~w', [Warning]),
  123.     call_emacs('(prolog-compilation-warning "~w" "~d" "~w")',
  124.            [File, Line, Msg]).
  125. exception(singleton,    singleton(Path, Line, Vars), _) :-
  126.     qp_warning_file(Path, File),
  127.     sformat(Msg, 'Warning: singleton variables: ~w', [Vars]),
  128.     call_emacs('(prolog-compilation-warning "~w" "~d" "~w")',
  129.            [File, Line, Msg]).
  130.  
  131.  
  132. qp_start_compilation :-
  133.     absolute_file_name('', Pwd),
  134.     asserta(compilation_base_dir(Pwd)),
  135.     call_emacs('(prolog-compilation-start "~w")', [Pwd]).
  136.  
  137.     
  138. qp_finish_compilation :-
  139.     retractall(qp_compilation_base_dir(_)),
  140.     call_emacs('(prolog-compilation-finish)').
  141.  
  142.  
  143. qp_warning_file(user, _) :- !,
  144.     fail.                      % donot give warnings here
  145. qp_warning_file(Path, File) :-
  146.     compilation_base_dir(Cwd),
  147.     concat(Cwd, File, Path), !.
  148. qp_warning_file(Path, Path).
  149.     
  150.  
  151.         /********************************
  152.         *         FIND PREDICATE    *
  153.         ********************************/
  154.  
  155. %    find_predicate1(Name, Arity)
  156. %
  157.  
  158. find_predicate1(Name, Arity) :-
  159.     find_predicate(Name, Arity, Preds),
  160.     (   Preds == []
  161.     ->  call_emacs('(@find "undefined" "nodebug")')
  162.     ;   forall(member(Head, Preds),
  163.            (source_file(Head, File),
  164.             call_emacs('(@fd-in "\"~w\" ~w ~w")', [Name, Arity, File])
  165.            ))
  166.     ->  call_emacs('(@find "ok" "nodebug")')
  167.     ;   call_emacs('(@find "none" "nodebug")')
  168.     ).
  169.     
  170.  
  171. find_predicate(Name, Arity, Preds) :-
  172.     (   integer(Arity)
  173.     ->  functor(Head, Name, Arity)
  174.     ;   true
  175.     ),
  176.     findall(Pred, find_predicate_(Head, Pred), Preds).
  177.  
  178. find_predicate_(Head, Module:Head) :-
  179.     current_predicate(_, Module:Head),
  180.     \+ predicate_property(Module:Head, imported_from(_)).
  181.     
  182.  
  183.         /********************************
  184.         *          ATOM DABREV        *
  185.         ********************************/
  186.  
  187. qp_dabbrev_atom(Sofar) :-
  188.     '$complete_atom'(Sofar, Extended, Unique), !,
  189.     map_unique_to_lisp(Unique, LispBool),
  190.     call_emacs('(prolog-complete-atom-with "~s" ~w)',
  191.            [Extended, LispBool]).
  192. qp_dabbrev_atom(Sofar) :-
  193.     call_emacs('(prolog-completion-error-message (concat "No completions for: " "~s"))', [Sofar]).
  194.  
  195. map_unique_to_lisp(unique, t).
  196. map_unique_to_lisp(not_unique, nil).
  197.  
  198.  
  199.         /********************************
  200.         *         ATOM COMPLETION    *
  201.         ********************************/
  202.  
  203. qp_complete_atom(Sofar) :-
  204.     '$atom_completions'(Sofar, List), List \== [], !,
  205.     call_emacs('(prolog-completions-start-collect)'),
  206.     qp_transfer_completions(List, 1),
  207.     call_emacs('(prolog-completions-run "~s")', [Sofar]).
  208. qp_complete_atom(Sofar) :-
  209.     call_emacs('(prolog-completion-error-message (concat "No completions for: " "~s"))', [Sofar]).
  210.  
  211. qp_transfer_completions([], _).
  212. qp_transfer_completions([Atom|T], N) :-
  213.     call_emacs('(prolog-transfer-completion "~w" ~d)', [Atom, N]),
  214.     NN is N + 1,
  215.     qp_transfer_completions(T, NN).
  216.  
  217.  
  218.         /********************************
  219.         *             HISTORY        *
  220.         ********************************/
  221.  
  222. qp_insert_command(Nr) :-
  223.     recorded('$history_list', Nr/Command), !,
  224.     flag(qp_shown_command, _, Nr),
  225.     call_emacs('(prolog-insert-history-command "~w")', Command).
  226. qp_insert_command(_) :-
  227.     call_emacs('(prolog-completion-error-message "No more commands")').
  228.  
  229. qp_previous_command :-
  230.     flag('$last_event', Last, Last),
  231.     (   flag(qp_last_command, Last, Last)
  232.     ->  flag(qp_shown_command, Shown, Shown),
  233.         This is Shown - 1,
  234.         qp_insert_command(This)
  235.     ;   flag(qp_last_command, _, Last),
  236.         qp_insert_command(Last)
  237.     ).
  238.         
  239.  
  240. qp_next_command :-
  241.     flag('$last_event', Last, Last),
  242.     (   flag(qp_last_command, Last, Last)
  243.     ->  flag(qp_shown_command, Shown, Shown),
  244.         This is Shown + 1,
  245.         qp_insert_command(This)
  246.     ;   flag(qp_last_command, _, Last),
  247.         qp_insert_command(Last)
  248.     ).
  249.  
  250.  
  251.         /********************************
  252.         *           CALL EMACS        *
  253.         ********************************/
  254.  
  255. call_emacs(Fmt) :-
  256.     call_emacs(Fmt, []).
  257. call_emacs(Fmt, Args) :-
  258.     concat_atom(['', Fmt, ''], F1),
  259.     format(F1, Args),
  260.     flush.
  261.  
  262.